home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / gets52.zip / GETSYSSK.PRG < prev    next >
Text File  |  1993-03-27  |  19KB  |  1,014 lines
  1. /*
  2.  
  3.    GETSYS.PRG mods to facilitate "jumping" by:
  4.    Steve Kolterman [76320,37]
  5.  
  6.    All noted with "added by SK."
  7.  
  8.    Example from a postblock:
  9.    ------------------------
  10.  
  11.    // this would be at the top of the .PRG:
  12.    #define GE_JUMP  10
  13.  
  14.    // position to jump to is saved in 'nPos':
  15.    oGet:exitstate:= GE_JUMP
  16.    ReadPos( nPos )
  17.  
  18.    // that's it.
  19.  
  20.    Also added READ time out capability, e.g., 5 secs.:
  21.    // time out in 5 secs. with an 'exitstate' of GE_WRITE...
  22.    ReadModal( getlist,nPos,{ 5,GE_WRITE } )
  23.  
  24.    from a postblock:
  25.    ReadTimeOut( { 5,GE_WRITE } )
  26.  
  27.    the following are also valid:
  28.    // don't need to change the exitstate.
  29.    ReadTimeOut( {5,} )
  30.  
  31.    // don't need to change the number of secs.
  32.    ReadTimeout( {,GE_ESCAPE} )
  33.  
  34.    see line 496 for one more change.
  35.  
  36.    // that's it II.  <s>
  37.  
  38. */
  39.  
  40. /***
  41. *
  42. *  Getsys.prg
  43. *
  44. *  Standard Clipper 5.2 GET/READ Subsystem
  45. *
  46. *  Copyright (c) 1991-1993, Computer Associates International, Inc.
  47. *  All rights reserved.
  48. *
  49. *  This version adds the following public functions:
  50. *
  51. *     ReadKill( [<lKill>] )       --> lKill
  52. *     ReadUpdated( [<lUpdated>] ) --> lUpdated
  53. *     ReadFormat( [<bFormat>] )   --> bFormat | NIL
  54. *
  55. *  NOTE: compile with /m /n /w
  56. *
  57. */
  58.  
  59. #include "Inkey.ch"
  60. #include "Getexit.ch"
  61.  
  62. #define K_UNDO          K_CTRL_U
  63.  
  64. // added by SK.
  65. #define GE_JUMP         10
  66.  
  67. //
  68. // State variables for active READ
  69. //
  70. STATIC sbFormat
  71. STATIC slUpdated := .F.
  72. STATIC slKillRead
  73. STATIC slBumpTop
  74. STATIC slBumpBot
  75. STATIC snLastExitState
  76. STATIC snLastPos
  77. STATIC soActiveGet
  78. STATIC scReadProcName
  79. STATIC snReadProcLine
  80. // added by SK.
  81. STATIC snReadPos:= 0
  82. // added by SK.
  83. STATIC saReadTimeout:= {0,GE_WRITE}
  84.  
  85. //
  86. // Format of array used to preserve state variables
  87. //
  88. #define GSV_KILLREAD       1
  89. #define GSV_BUMPTOP        2
  90. #define GSV_BUMPBOT        3
  91. #define GSV_LASTEXIT       4
  92. #define GSV_LASTPOS        5
  93. #define GSV_ACTIVEGET      6
  94. #define GSV_READVAR        7
  95. #define GSV_READPROCNAME   8
  96. #define GSV_READPROCLINE   9
  97. #define GSV_READPOS        10
  98. #define GSV_READTIMEOUT    11
  99.  
  100. #define GSV_COUNT          11
  101.  
  102. // added by SK.
  103. #define TIMEOUT_SECS       saReadTimeOut[1]
  104. #define TIMEOUT_EXITSTATE  saReadTimeOut[2]
  105.  
  106. /***
  107. *
  108. *  ReadModal()
  109. *
  110. *  Standard modal READ on an array of GETs
  111. *
  112. */
  113. FUNCTION ReadModal( GetList, nPos, aTimeout )
  114.  
  115.    LOCAL oGet
  116.    LOCAL aSavGetSysVars
  117.  
  118.    IF ( VALTYPE( sbFormat ) == "B" )
  119.       EVAL( sbFormat )
  120.    ENDIF
  121.  
  122.    IF ( EMPTY( GetList ) )
  123.       
  124.       // S'87 compatibility
  125.       SETPOS( MAXROW() - 1, 0 )
  126.       RETURN (.F.)                  // NOTE
  127.  
  128.    ENDIF
  129.  
  130.    // Preserve state variables
  131.    aSavGetSysVars := ClearGetSysVars()
  132.  
  133.    // Set these for use in SET KEYs
  134.    scReadProcName := PROCNAME( 1 )
  135.    snReadProcLine := PROCLINE( 1 )
  136.  
  137.    // Set initial GET to be read
  138.    IF !( VALTYPE( nPos ) == "N" .AND. nPos > 0 )
  139.       nPos := Settle( Getlist, 0 )
  140.    ENDIF
  141.  
  142.    // added by SK.
  143.    IIF( valtype(aTimeout)=="A",ReadTimeOut(aTimeout), )
  144.  
  145.    WHILE !( nPos == 0 )
  146.  
  147.       // Get next GET from list and post it as the active GET
  148.       PostActiveGet( oGet := GetList[ nPos ] )
  149.  
  150.       // added by SK.
  151.       // post 'getlist' position.
  152.       ReadPos( nPos )
  153.  
  154.       // Read the GET
  155.       IF ( VALTYPE( oGet:reader ) == "B" )
  156.          EVAL( oGet:reader, oGet )    // Use custom reader block
  157.       ELSE
  158.          GetReader( oGet )            // Use standard reader
  159.       ENDIF
  160.  
  161.       // Move to next GET based on exit condition
  162.       nPos := Settle( GetList, nPos )
  163.  
  164.    ENDDO
  165.  
  166.  
  167.    // Restore state variables
  168.    RestoreGetSysVars( aSavGetSysVars )
  169.  
  170.    // S'87 compatibility
  171.    SETPOS( MAXROW() - 1, 0 )
  172.  
  173.    RETURN ( slUpdated )
  174.  
  175.  
  176.  
  177. /***
  178. *
  179. *  GetReader()
  180. *
  181. *  Standard modal read of a single GET
  182. *
  183. */
  184. PROCEDURE GetReader( oGet )
  185. LOCAL nKey
  186.  
  187.    // Read the GET if the WHEN condition is satisfied
  188.    IF ( GetPreValidate( oGet ) )
  189.  
  190.       // Activate the GET for reading
  191.       oGet:setFocus()
  192.  
  193.       WHILE ( oGet:exitState == GE_NOEXIT )
  194.  
  195.          // Check for initial typeout (no editable positions)
  196.          IF ( oGet:typeOut )
  197.             oGet:exitState := GE_ENTER
  198.          ENDIF
  199.  
  200.          // Apply keystrokes until exit
  201.          WHILE ( oGet:exitState == GE_NOEXIT )
  202.             IF (nKey:= Inkey(TIMEOUT_SECS)) == 0
  203.                oGet:exitstate:= TIMEOUT_EXITSTATE
  204.             ELSE
  205.                GetApplyKey( oGet, nKey )
  206.             ENDIF
  207.          ENDDO
  208.  
  209.          // Disallow exit if the VALID condition is not satisfied
  210.          IF ( !GetPostValidate( oGet ) )
  211.             oGet:exitState := GE_NOEXIT
  212.          ENDIF
  213.       ENDDO
  214.  
  215.       // De-activate the GET
  216.       oGet:killFocus()
  217.  
  218.    ENDIF
  219.  
  220.    RETURN
  221.  
  222.  
  223.  
  224. /***
  225. *
  226. *  GetApplyKey()
  227. *
  228. *  Apply a single INKEY() keystroke to a GET
  229. *
  230. *  NOTE: GET must have focus.
  231. *
  232. */
  233. PROCEDURE GetApplyKey( oGet, nKey )
  234.  
  235.    LOCAL cKey
  236.    LOCAL bKeyBlock
  237.  
  238.    // Check for SET KEY first
  239.    IF !( ( bKeyBlock := setkey( nKey ) ) == NIL )
  240.       GetDoSetKey( bKeyBlock, oGet )
  241.       RETURN                           // NOTE
  242.    ENDIF
  243.  
  244.    DO CASE
  245.    CASE ( nKey == K_UP )
  246.       oGet:exitState := GE_UP
  247.  
  248.    CASE ( nKey == K_SH_TAB )
  249.       oGet:exitState := GE_UP
  250.  
  251.    CASE ( nKey == K_DOWN )
  252.       oGet:exitState := GE_DOWN
  253.  
  254.    CASE ( nKey == K_TAB )
  255.       oGet:exitState := GE_DOWN
  256.  
  257.    CASE ( nKey == K_ENTER )
  258.       oGet:exitState := GE_ENTER
  259.  
  260.    CASE ( nKey == K_ESC )
  261.       IF ( SET( _SET_ESCAPE ) )
  262.          
  263.          oGet:undo()
  264.          oGet:exitState := GE_ESCAPE
  265.  
  266.       ENDIF
  267.  
  268.    CASE ( nKey == K_PGUP )
  269.       oGet:exitState := GE_WRITE
  270.  
  271.    CASE ( nKey == K_PGDN )
  272.       oGet:exitState := GE_WRITE
  273.  
  274.    CASE ( nKey == K_CTRL_HOME )
  275.       oGet:exitState := GE_TOP
  276.  
  277.  
  278. #ifdef CTRL_END_SPECIAL
  279.  
  280.    // Both ^W and ^End go to the last GET
  281.    CASE ( nKey == K_CTRL_END )
  282.       oGet:exitState := GE_BOTTOM
  283.  
  284. #else
  285.  
  286.    // Both ^W and ^End terminate the READ (the default)
  287.    CASE ( nKey == K_CTRL_W )
  288.       oGet:exitState := GE_WRITE
  289.  
  290. #endif
  291.  
  292.  
  293.    CASE ( nKey == K_INS )
  294.       SET( _SET_INSERT, !SET( _SET_INSERT ) )
  295.       ShowScoreboard()
  296.  
  297.    CASE ( nKey == K_UNDO )
  298.       oGet:undo()
  299.  
  300.    CASE ( nKey == K_HOME )
  301.       oGet:home()
  302.  
  303.    CASE ( nKey == K_END )
  304.       oGet:end()
  305.  
  306.    CASE ( nKey == K_RIGHT )
  307.       oGet:right()
  308.  
  309.    CASE ( nKey == K_LEFT )
  310.       oGet:left()
  311.  
  312.    CASE ( nKey == K_CTRL_RIGHT )
  313.       oGet:wordRight()
  314.  
  315.    CASE ( nKey == K_CTRL_LEFT )
  316.       oGet:wordLeft()
  317.  
  318.    CASE ( nKey == K_BS )
  319.       oGet:backSpace()
  320.  
  321.    CASE ( nKey == K_DEL )
  322.       oGet:delete()
  323.  
  324.    CASE ( nKey == K_CTRL_T )
  325.       oGet:delWordRight()
  326.  
  327.    CASE ( nKey == K_CTRL_Y )
  328.       oGet:delEnd()
  329.  
  330.    CASE ( nKey == K_CTRL_BS )
  331.       oGet:delWordLeft()
  332.  
  333.    OTHERWISE
  334.  
  335.       IF ( nKey >= 32 .AND. nKey <= 255 )
  336.  
  337.          cKey := CHR( nKey )
  338.  
  339.          IF ( oGet:type == "N" .AND. ( cKey == "." .OR. cKey == "," ) )
  340.             oGet:toDecPos()
  341.          ELSE
  342.             
  343.             IF ( SET( _SET_INSERT ) )
  344.                oGet:insert( cKey )
  345.             ELSE
  346.                oGet:overstrike( cKey )
  347.             ENDIF
  348.  
  349.             IF ( oGet:typeOut )
  350.                IF ( SET( _SET_BELL ) )
  351.                   ?? CHR(7)
  352.                ENDIF
  353.  
  354.                IF ( !SET( _SET_CONFIRM ) )
  355.                   oGet:exitState := GE_ENTER
  356.                ENDIF
  357.             ENDIF
  358.  
  359.          ENDIF
  360.  
  361.       ENDIF
  362.  
  363.    ENDCASE
  364.  
  365.    RETURN
  366.  
  367.  
  368.  
  369. /***
  370. *
  371. *  GetPreValidate()
  372. *
  373. *  Test entry condition (WHEN clause) for a GET
  374. *
  375. */
  376. FUNCTION GetPreValidate( oGet )
  377.  
  378.    LOCAL lSavUpdated
  379.    LOCAL lWhen := .T.
  380.  
  381.    IF !( oGet:preBlock == NIL )
  382.  
  383.       lSavUpdated := slUpdated
  384.  
  385.       lWhen := EVAL( oGet:preBlock, oGet )
  386.  
  387.       oGet:display()
  388.  
  389.       ShowScoreBoard()
  390.       slUpdated := lSavUpdated
  391.  
  392.    ENDIF
  393.  
  394.    IF ( slKillRead )
  395.       
  396.       lWhen := .F.
  397.       oGet:exitState := GE_ESCAPE       // Provokes ReadModal() exit
  398.  
  399.    ELSEIF ( !lWhen )
  400.       
  401.       oGet:exitState := GE_WHEN         // Indicates failure
  402.  
  403.    ELSE
  404.       
  405.       oGet:exitState := GE_NOEXIT       // Prepares for editing
  406.  
  407.    END
  408.  
  409.    RETURN ( lWhen )
  410.  
  411.  
  412.  
  413. /***
  414. *
  415. *  GetPostValidate()
  416. *
  417. *  Test exit condition (VALID clause) for a GET
  418. *
  419. *  NOTE: Bad dates are rejected in such a way as to preserve edit buffer
  420. *
  421. */
  422. FUNCTION GetPostValidate( oGet )
  423.  
  424.    LOCAL lSavUpdated
  425.    LOCAL lValid := .T.
  426.  
  427.  
  428.    IF ( oGet:exitState == GE_ESCAPE )
  429.       RETURN ( .T. )                   // NOTE
  430.    ENDIF
  431.  
  432.    IF ( oGet:badDate() )
  433.       oGet:home()
  434.       DateMsg()
  435.       ShowScoreboard()
  436.       RETURN ( .F. )                   // NOTE
  437.    ENDIF
  438.  
  439.    // If editing occurred, assign the new value to the variable
  440.    IF ( oGet:changed )
  441.       oGet:assign()
  442.       slUpdated := .T.
  443.    ENDIF
  444.  
  445.    // Reform edit buffer, set cursor to home position, redisplay
  446.    oGet:reset()
  447.  
  448.    // Check VALID condition if specified
  449.    IF !( oGet:postBlock == NIL )
  450.  
  451.       lSavUpdated := slUpdated
  452.  
  453.       // S'87 compatibility
  454.       SETPOS( oGet:row, oGet:col + LEN( oGet:buffer ) )
  455.  
  456.       lValid := EVAL( oGet:postBlock, oGet )
  457.  
  458.       // Reset S'87 compatibility cursor position
  459.       SETPOS( oGet:row, oGet:col )
  460.  
  461.       ShowScoreBoard()
  462.       oGet:updateBuffer()
  463.  
  464.       slUpdated := lSavUpdated
  465.  
  466.       IF ( slKillRead )
  467.          oGet:exitState := GE_ESCAPE      // Provokes ReadModal() exit
  468.          lValid := .T.
  469.  
  470.       ENDIF
  471.    ENDIF
  472.  
  473.    RETURN ( lValid )
  474.  
  475.  
  476.  
  477. /***
  478. *
  479. *  GetDoSetKey()
  480. *
  481. *  Process SET KEY during editing
  482. *
  483. */
  484. PROCEDURE GetDoSetKey( keyBlock, oGet )
  485.  
  486.    LOCAL lSavUpdated
  487.  
  488.    // If editing has occurred, assign variable
  489.    IF ( oGet:changed )
  490.       oGet:assign()
  491.       slUpdated := .T.
  492.    ENDIF
  493.  
  494.    lSavUpdated := slUpdated
  495.  
  496.    // this, I proposed to Clipper developer Robert DiFalco, but he turned
  497.    // me down...coldly, cruelly.  <g>
  498.  
  499.    // send 'keyBlock' a ref. to the current GET so as to avoid need to
  500.    // declare a separate LOCAL for it (Getactive()).
  501.    EVAL( keyBlock, scReadProcName, snReadProcLine, ReadVar(), oGet )
  502.  
  503.    ShowScoreboard()
  504.    oGet:updateBuffer()
  505.  
  506.    slUpdated := lSavUpdated
  507.  
  508.    IF ( slKillRead )
  509.       oGet:exitState := GE_ESCAPE      // provokes ReadModal() exit
  510.    ENDIF
  511.  
  512.    RETURN
  513.  
  514.  
  515. /***
  516. *              READ services
  517. */
  518.  
  519.  
  520.  
  521. /***
  522. *
  523. *  Settle()
  524. *
  525. *  Returns new position in array of Get objects, based on:
  526. *     - current position
  527. *     - exitState of Get object at current position
  528. *
  529. *  NOTES: return value of 0 indicates termination of READ
  530. *         exitState of old Get is transferred to new Get
  531. *
  532. */
  533. STATIC FUNCTION Settle( GetList, nPos )
  534.  
  535.    LOCAL nExitState
  536.  
  537.    IF ( nPos == 0 )
  538.       nExitState := GE_DOWN
  539.    ELSE
  540.       nExitState := GetList[ nPos ]:exitState
  541.    ENDIF
  542.  
  543.    IF ( nExitState == GE_ESCAPE .or. nExitState == GE_WRITE )
  544.       RETURN ( 0 )               // NOTE
  545.    ENDIF
  546.  
  547.    IF !( nExitState == GE_WHEN )
  548.       // Reset state info
  549.       snLastPos := nPos
  550.       slBumpTop := .F.
  551.       slBumpBot := .F.
  552.    ELSE
  553.       // Re-use last exitState, do not disturb state info
  554.       nExitState := snLastExitState
  555.    ENDIF
  556.  
  557.    //
  558.    // Move
  559.    //
  560.    DO CASE
  561.  
  562.    // added by SK.
  563.    CASE ( nExitState== GE_JUMP )
  564.       nPos:= ReadPos()
  565.  
  566.    CASE ( nExitState == GE_UP )
  567.       nPos--
  568.  
  569.    CASE ( nExitState == GE_DOWN )
  570.       nPos++
  571.  
  572.    CASE ( nExitState == GE_TOP )
  573.       nPos       := 1
  574.       slBumpTop  := .T.
  575.       nExitState := GE_DOWN
  576.  
  577.    CASE ( nExitState == GE_BOTTOM )
  578.       nPos       := LEN( GetList )
  579.       slBumpBot  := .T.
  580.       nExitState := GE_UP
  581.  
  582.    CASE ( nExitState == GE_ENTER )
  583.       nPos++
  584.  
  585.    ENDCASE
  586.  
  587.    //
  588.    // Bounce
  589.    //
  590.    IF ( nPos == 0 )                       // Bumped top
  591.       IF ( !ReadExit() .and. !slBumpBot )
  592.          slBumpTop  := .T.
  593.          nPos       := snLastPos
  594.          nExitState := GE_DOWN
  595.       ENDIF
  596.  
  597.    ELSEIF ( nPos == len( GetList ) + 1 )  // Bumped bottom
  598.       IF ( !ReadExit() .and. !( nExitState == GE_ENTER ) .and. !slBumpTop )
  599.          slBumpBot  := .T.
  600.          nPos       := snLastPos
  601.          nExitState := GE_UP
  602.       ELSE
  603.          nPos := 0
  604.       ENDIF
  605.    ENDIF
  606.  
  607.    // Record exit state
  608.    snLastExitState := nExitState
  609.  
  610.    IF !( nPos == 0 )
  611.       GetList[ nPos ]:exitState := nExitState
  612.    ENDIF
  613.    
  614.    RETURN ( nPos )
  615.  
  616.  
  617.  
  618. /***
  619. *
  620. *  PostActiveGet()
  621. *
  622. *  Post active GET for ReadVar(), GetActive()
  623. *
  624. */
  625. STATIC PROCEDURE PostActiveGet( oGet )
  626.  
  627.    GetActive( oGet )
  628.    ReadVar( GetReadVar( oGet ) )
  629.  
  630.    ShowScoreBoard()
  631.  
  632.    RETURN
  633.  
  634.  
  635.  
  636. /***
  637. *
  638. *  ClearGetSysVars()
  639. *
  640. *  Save and clear READ state variables. Return array of saved values
  641. *
  642. *  NOTE: 'Updated' status is cleared but not saved (S'87 compatibility)
  643. */
  644. STATIC FUNCTION ClearGetSysVars()
  645.  
  646.    LOCAL aSavSysVars[ GSV_COUNT ]
  647.  
  648.    // Save current sys vars
  649.    aSavSysVars[ GSV_KILLREAD ]     := slKillRead
  650.    aSavSysVars[ GSV_BUMPTOP ]      := slBumpTop
  651.    aSavSysVars[ GSV_BUMPBOT ]      := slBumpBot
  652.    aSavSysVars[ GSV_LASTEXIT ]     := snLastExitState
  653.    aSavSysVars[ GSV_LASTPOS ]      := snLastPos
  654.    aSavSysVars[ GSV_ACTIVEGET ]    := GetActive( NIL )
  655.    aSavSysVars[ GSV_READVAR ]      := ReadVar( "" )
  656.    aSavSysVars[ GSV_READPROCNAME ] := scReadProcName
  657.    aSavSysVars[ GSV_READPROCLINE ] := snReadProcLine
  658.    aSavSysVars[ GSV_READPOS ]      := snReadPos
  659.    aSavSysVars[ GSV_READTIMEOUT ]  := saReadTimeOut
  660.  
  661.    // Re-init old ones
  662.    slKillRead      := .F.
  663.    slBumpTop       := .F.
  664.    slBumpBot       := .F.
  665.    snLastExitState := 0
  666.    snLastPos       := 0
  667.    scReadProcName  := ""
  668.    snReadProcLine  := 0
  669.    slUpdated       := .F.
  670.    snReadPos       := 0
  671.    saReadTimeout   := {0,GE_WRITE}
  672.  
  673.    RETURN ( aSavSysVars )
  674.  
  675.  
  676.  
  677. /***
  678. *
  679. *  RestoreGetSysVars()
  680. *
  681. *  Restore READ state variables from array of saved values
  682. *
  683. *  NOTE: 'Updated' status is not restored (S'87 compatibility)
  684. *
  685. */
  686. STATIC PROCEDURE RestoreGetSysVars( aSavSysVars )
  687.  
  688.    slKillRead      := aSavSysVars[ GSV_KILLREAD ]
  689.    slBumpTop       := aSavSysVars[ GSV_BUMPTOP ]
  690.    slBumpBot       := aSavSysVars[ GSV_BUMPBOT ]
  691.    snLastExitState := aSavSysVars[ GSV_LASTEXIT ]
  692.    snLastPos       := aSavSysVars[ GSV_LASTPOS ]
  693.  
  694.    GetActive( aSavSysVars[ GSV_ACTIVEGET ] )
  695.  
  696.    ReadVar( aSavSysVars[ GSV_READVAR ] )
  697.  
  698.    scReadProcName  := aSavSysVars[ GSV_READPROCNAME ]
  699.    snReadProcLine  := aSavSysVars[ GSV_READPROCLINE ]
  700.    snReadPos       := aSavSysVars[ GSV_READPOS ]
  701.    saReadTimeOut   := aSavSysVars[ GSV_READTIMEOUT ]
  702.  
  703.    RETURN
  704.  
  705.  
  706. /***
  707. *
  708. *  GetReadVar()
  709. *
  710. *  Set READVAR() value from a GET
  711. *
  712. */
  713. STATIC FUNCTION GetReadVar( oGet )
  714.  
  715.    LOCAL cName := UPPER( oGet:name )
  716.    LOCAL i
  717.  
  718.    // The following code includes subscripts in the name returned by
  719.    // this FUNCTIONtion, if the get variable is an array element
  720.    //
  721.    // Subscripts are retrieved from the oGet:subscript instance variable
  722.    //
  723.    // NOTE: Incompatible with Summer 87
  724.    //
  725.    IF !( oGet:subscript == NIL )
  726.       FOR i := 1 TO LEN( oGet:subscript )
  727.          cName += "[" + LTRIM( STR( oGet:subscript[i] ) ) + "]"
  728.       NEXT
  729.    END
  730.  
  731.    RETURN ( cName )
  732.  
  733.  
  734. /***
  735. *              System Services
  736. */
  737.  
  738.  
  739.  
  740. /***
  741. *
  742. *  __SetFormat()
  743. *  
  744. *  SET FORMAT service
  745. *
  746. */
  747. PROCEDURE __SetFormat( b )
  748.    sbFormat := IF( VALTYPE( b ) == "B", b, NIL )
  749.    RETURN
  750.  
  751.  
  752.  
  753. /***
  754. *
  755. *  __KillRead()
  756. *
  757. *  CLEAR GETS service
  758. *
  759. */
  760. PROCEDURE __KillRead()
  761.    slKillRead := .T.
  762.    RETURN
  763.  
  764.  
  765.  
  766. /***
  767. *
  768. *  GetActive()
  769. *
  770. *  Retrieves currently active GET object
  771. */
  772. FUNCTION GetActive( g )
  773.  
  774.    LOCAL oldActive := soActiveGet
  775.  
  776.    IF ( PCOUNT() > 0 )
  777.       soActiveGet := g
  778.    ENDIF
  779.  
  780.    RETURN ( oldActive )
  781.  
  782.  
  783.  
  784. /***
  785. *
  786. *  Updated()
  787. *
  788. */
  789. FUNCTION Updated()
  790.    RETURN slUpdated
  791.  
  792.  
  793.  
  794. /***
  795. *
  796. *  ReadExit()
  797. *
  798. */
  799. FUNCTION ReadExit( lNew )
  800.    RETURN ( SET( _SET_EXIT, lNew ) )
  801.  
  802.  
  803.  
  804. /***
  805. *
  806. *  ReadInsert()
  807. *
  808. */
  809. FUNCTION ReadInsert( lNew )
  810.    RETURN ( SET( _SET_INSERT, lNew ) )
  811.  
  812.  
  813.  
  814. /***
  815. *              Wacky Compatibility Services
  816. */
  817.  
  818.  
  819. // Display coordinates for SCOREBOARD
  820. #define SCORE_ROW      0
  821. #define SCORE_COL      60
  822.  
  823.  
  824. /***
  825. *
  826. *  ShowScoreboard()
  827. *
  828. */
  829. STATIC PROCEDURE ShowScoreboard()
  830.  
  831.    LOCAL nRow
  832.    LOCAL nCol
  833.  
  834.    IF ( SET( _SET_SCOREBOARD ) )
  835.       nRow := ROW()
  836.       nCol := COL()
  837.  
  838.       SETPOS( SCORE_ROW, SCORE_COL )
  839.       DISPOUT( IF( SET( _SET_INSERT ), "Ins", "   " ) )
  840.       SETPOS( nRow, nCol )
  841.    ENDIF
  842.  
  843.    RETURN
  844.  
  845.  
  846.  
  847. /***
  848. *
  849. *  DateMsg()
  850. *
  851. */
  852. STATIC PROCEDURE DateMsg()
  853.  
  854.    LOCAL nRow
  855.    LOCAL nCol
  856.  
  857.    IF ( SET( _SET_SCOREBOARD ) )
  858.       
  859.       nRow := ROW()
  860.       nCol := COL()
  861.  
  862.       SETPOS( SCORE_ROW, SCORE_COL )
  863.       DISPOUT( "Invalid Date" )
  864.       SETPOS( nRow, nCol )
  865.  
  866.       WHILE ( NEXTKEY() == 0 )
  867.       END
  868.  
  869.       SETPOS( SCORE_ROW, SCORE_COL )
  870.       DISPOUT( SPACE( 12 ) )
  871.       SETPOS( nRow, nCol )
  872.  
  873.    ENDIF
  874.  
  875.    RETURN
  876.  
  877.  
  878.  
  879. /***
  880. *
  881. *  RangeCheck()
  882. *
  883. *  NOTE: Unused second param for 5.00 compatibility.
  884. *
  885. */
  886. FUNCTION RangeCheck( oGet, junk, lo, hi )
  887.  
  888.    LOCAL cMsg, nRow, nCol
  889.    LOCAL xValue
  890.  
  891.    IF ( !oGet:changed )
  892.       RETURN ( .T. )          // NOTE
  893.    ENDIF
  894.  
  895.    xValue := oGet:varGet()
  896.  
  897.    IF ( xValue >= lo .and. xValue <= hi )
  898.       RETURN ( .T. )          // NOTE
  899.    ENDIF
  900.  
  901.    IF ( SET(_SET_SCOREBOARD) )
  902.       
  903.       cMsg := "Range: " + LTRIM( TRANSFORM( lo, "" ) ) + ;
  904.             " - " + LTRIM( TRANSFORM( hi, "" ) )
  905.  
  906.       IF ( LEN( cMsg ) > MAXCOL() )
  907.          cMsg := SUBSTR( cMsg, 1, MAXCOL() )
  908.       ENDIF
  909.  
  910.       nRow := ROW()
  911.       nCol := COL()
  912.  
  913.       SETPOS( SCORE_ROW, MIN( 60, MAXCOL() - LEN( cMsg ) ) )
  914.       DISPOUT( cMsg )
  915.       SETPOS( nRow, nCol )
  916.  
  917.       WHILE ( NEXTKEY() == 0 )
  918.       END
  919.  
  920.       SETPOS( SCORE_ROW, MIN( 60, MAXCOL() - LEN( cMsg ) ) )
  921.       DISPOUT( SPACE( LEN( cMsg ) ) )
  922.       SETPOS( nRow, nCol )
  923.  
  924.    ENDIF
  925.  
  926.    RETURN ( .F. )
  927.  
  928.  
  929.  
  930. /***
  931. *
  932. *  ReadKill()
  933. *
  934. */
  935. FUNCTION ReadKill( lKill )
  936.  
  937.    LOCAL lSavKill := slKillRead
  938.  
  939.    IF ( PCOUNT() > 0 )
  940.       slKillRead := lKill
  941.    ENDIF
  942.  
  943.    RETURN ( lSavKill )
  944.  
  945.  
  946.  
  947. /***
  948. *
  949. *  ReadUpdated()
  950. *
  951. */
  952. FUNCTION ReadUpdated( lUpdated )
  953.    
  954.    LOCAL lSavUpdated := slUpdated
  955.    
  956.    IF ( PCOUNT() > 0 )
  957.       slUpdated := lUpdated
  958.    ENDIF
  959.  
  960.    RETURN ( lSavUpdated )
  961.       
  962.  
  963.  
  964. /***
  965. *
  966. *  ReadFormat()
  967. *
  968. */
  969. FUNCTION ReadFormat( b )
  970.    
  971.    LOCAL bSavFormat := sbFormat
  972.  
  973.    IF ( PCOUNT() > 0 )
  974.       sbFormat := b
  975.    ENDIF
  976.  
  977.    RETURN ( bSavFormat )
  978.  
  979. /***
  980. *
  981. *  Added by SK.
  982. *
  983. *  ReadPos()
  984. *
  985. */
  986. FUNCTION ReadPos( nPos )
  987.    
  988.    LOCAL nSavPos := snReadPos
  989.  
  990.    IIF( valtype(nPos)=="N", snReadPos:= nPos, )
  991.  
  992.    RETURN ( nSavPos )
  993.  
  994. /***
  995. *
  996. *  Added by SK.
  997. *
  998. *  ReadTimeOut()
  999. *
  1000. */
  1001. FUNCTION ReadTimeout( aTimeout )
  1002.    
  1003.    LOCAL aSavTimeout := saReadTimeout
  1004.  
  1005.    IF Len(aTimeout) == 2
  1006.       IIF( valtype(aTimeout)=="A" .and. valtype(aTimeout[1])=="N" ,;
  1007.            TIMEOUT_SECS:= aTimeout[1], )
  1008.  
  1009.       IIF( valtype(aTimeout)=="A" .and. valtype(aTimeout[2])=="N" ,;
  1010.            TIMEOUT_EXITSTATE:= aTimeout[2], )
  1011.    ENDIF
  1012.  
  1013.    RETURN ( aSavTimeout )
  1014.